home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / fdisp.tcl.z / fdisp.tcl
Text File  |  2002-07-08  |  30KB  |  1,030 lines
  1. #
  2. # fdisp.tcl
  3. #
  4. # Folder display, handling nesting and highlights to reflect folder state.
  5. #
  6. # Copyright (c) 1993 Xerox Corporation.
  7. # Use and copying of this software and preparation of derivative works based
  8. # upon this software are permitted. Any distribution of this software or
  9. # derivative works must comply with all applicable United States export
  10. # control laws. This software is made available AS IS, and Xerox Corporation
  11. # makes no warranty about the software, its performance or its conformity to
  12. # any specification.
  13.  
  14. proc Fdisp_Init {} {
  15.     global fdisp mhProfile exmh flist
  16.  
  17.     if {[info exists exmh(newuser)] && [info exists flist(allfolders)]} {
  18.     set N [llength $flist(allfolders)]
  19.     if {$N < 5} {
  20.         set fdisp(maxLines) 1
  21.     } elseif {$N < 15} {
  22.         set fdisp(maxLines) 2
  23.     } elseif {$N < 30} {
  24.         set fdisp(maxLines) 3
  25.     } else {
  26.         set fdisp(maxLines) 4
  27.     }
  28.     }
  29.  
  30.     Preferences_Add "Folder Display" \
  31. "These items affect the display of the labels in the folder display window.
  32. If you change key bindings on labels, you'll have to toggle one of the other
  33. options to force a redisplay because that's when the bindings are set." {
  34.     {fdisp(maxLines) fdispLines 4 {Max fdisp rows}
  35. "The maximum number of rows of folder labels in
  36. the folder display.  If there are more folders than
  37. will fit in this space, the display becomes scrollable." }
  38.     {fdisp(toplevel) fl_toplevel OFF {Detached fdisp display}
  39. "The folder display area can be displayed in a separate
  40. toplevel window.  You can use the *Fltop.position Xresource
  41. to control its initial placement on the screen, and the
  42. *Fltop.Canvas.width and *Fltop.Canvas.height to control
  43. its size."}
  44.     {fdisp(oneCol) fdisp1Col OFF {Use one column}
  45. "Enabling this with a detached display aligns all the
  46. folders in one vertical column."}
  47.     {fdisp(popdownStyle) fdispPopdownStyle {CHOICE polygon rectangle} {Subfolder popdown}
  48. "The style of the sub folder popdown menu
  49. used to display subfolders." }
  50.     {fdisp(popdownAction) fdispPopdownAction {CHOICE navbutton enter redisplay} {Popdown action}
  51. "This determines how the popdown display is triggered:
  52. navbutton - press navigation button to get the popdown.
  53.  
  54. enter - move the mouse over the button to get the popdown.
  55.  
  56. redisplay - do not use popdowns at all.  Instead, navbutton
  57. causes the whole folder display to change.
  58.  
  59. The navigation button is settable via a X resource fl_navbutton." }
  60.     {fdisp(popdownRemove) fdispPopdownRemove {CHOICE leave navbutton} {Remove popdown on...}
  61. "This determines what causes a popdown display to be removed:
  62. navbutton - press navigation button on another label.
  63.  
  64. leave - leave the area of the popdown.  This actually is
  65. implemented by triggering on <Enter> to other labels.
  66.  
  67. The navigation button is settable via a X resource fl_navbutton." }
  68. {fdisp(tarbuttonAction) fdispTarbuttonAction {CHOICE {select+move} {select+copy} {select only}} {Action when Target button clicked...}
  69. "This determines what action is taken when the \"target\"
  70. mouse button is clicked.  The target button is usually mouse
  71. button 3 but can be changed by setting X resource fl_tarbutton.
  72.  
  73. select+move - Selects the folder at the mouse cursor as 
  74. the target folder and moves the current message to the
  75. target folder.
  76.  
  77. select+copy - Selects the folder at the mouse cursor as 
  78. the target folder and copies the current message to the
  79. target folder.
  80.  
  81. select only - Selects the folder at the mouse cursor as 
  82. the target folder." }
  83. {findSettings(defaultLoc) findSettingsDefaultLoc {CHOICE FTOC Msg}
  84. "Default search location"
  85. "Determines whether, initially, a search takes place in the \"folder
  86. table of contents\" window (if set to \"FTOC\") or the \"message\" window
  87. (if set to \"Msg\")."}
  88.     }
  89.     # The remaining parameters can be overridden by hand in the user resources
  90.  
  91.     Preferences_Resource fdisp(font)        fl_font fixed
  92.     Preferences_Resource fdisp(xgap)        fl_xgap 8
  93.     Preferences_Resource fdisp(ygap)        fl_ygap 8
  94.     Preferences_Resource fdisp(curbutton)    fl_curbutton 1
  95.     Preferences_Resource fdisp(navbutton)    fl_navbutton 2
  96.     Preferences_Resource fdisp(tarbutton)    fl_tarbutton 3
  97.  
  98.     Preferences_Resource fdisp(c_fg)        c_foreground black
  99.     Preferences_Resource fdisp(c_bg)        c_background white
  100.     Preferences_Resource fdisp(c_current)    c_current red
  101.     Preferences_Resource fdisp(c_unseen)    c_unseen  blue
  102.     Preferences_Resource fdisp(c_unseenBg)    c_unseenBg  $fdisp(c_bg)
  103.     Preferences_Resource fdisp(c_moved)        c_moved   yellow
  104.     Preferences_Resource fdisp(c_movedFg)    c_movedFg   $fdisp(c_fg)
  105.     Preferences_Resource fdisp(c_popup)        c_popup   wheat
  106.  
  107.     trace variable fdisp(font) w FdispFixupFont
  108.     set fdisp(lastFont) $fdisp(font)
  109.     trace variable fdisp(maxLines) w FdispFixupMaxLines
  110.     set fdisp(lastMaxLines) $fdisp(maxLines)
  111.     trace variable fdisp(toplevel) w FdispFixupToplevel
  112.     set fdisp(lastToplevel) $fdisp(toplevel)
  113.     trace variable fdisp(oneCol) w FdispFixupRedisplay
  114.     trace variable fdisp(popdownStyle) w FdispFixupRedisplay
  115. }
  116.  
  117. # Hooks for recreating the folder display when config changes
  118. proc FdispFixupMaxLines { args } {
  119.     global exwin fdisp
  120.  
  121.     if [catch {expr {$fdisp(maxLines) * 2}}] {
  122.     set fdisp(maxLines) $fdisp(lastMaxLines)
  123.     return    ;# bogus value
  124.     }
  125.     if {$fdisp(maxLines) != $fdisp(lastMaxLines)} {
  126.     set fdisp(width,canvas) 0
  127.     set fdisp(maxLines,$fdisp(canvas)) $fdisp(maxLines)
  128.     set fdisp(lastMaxLines) $fdisp(maxLines)
  129.     set h [expr {$fdisp(maxLines)*($fdisp(itemHeight) + $fdisp(ygap)) + $fdisp(ygap)}]
  130.     $fdisp(canvas) configure -height $h
  131.     }
  132. }
  133. proc FdispFixupRedisplay { args } {
  134.     Fdisp_Redisplay
  135. }
  136. proc FdispFixupToplevel { args } {
  137.     global fdisp
  138.     if {$fdisp(toplevel) != $fdisp(lastToplevel)} {
  139.     if [info exists fdisp(topWidget)] {
  140.         destroy $fdisp(topWidget)
  141.         unset fdisp(topWidget)
  142.     } else {
  143.         destroy $fdisp(frame)
  144.         unset fdisp(frame)
  145.     }
  146.     FdispMake
  147.     }
  148.     set fdisp(lastToplevel) $fdisp(toplevel)
  149. }
  150.  
  151. # Make the folder display
  152. proc FdispMake {} {
  153.     global fdisp
  154.     if {$fdisp(toplevel)} {
  155.     FdispMakeToplevel
  156.     } else {
  157.     FdispMakeFrame
  158.     }
  159. }
  160.  
  161. # Create folder list in a toplevel and make the canvas inside it
  162. proc FdispMakeToplevel { } {
  163.     global fdisp
  164.     Exwin_Toplevel .fl "Folder list" Fltop nomenu
  165.     wm protocol .fl WM_TAKE_FOCUS {
  166.     global exwin
  167.     focus $exwin(mtext)
  168.     }
  169.     set fdisp(topWidget) .fl
  170.     wm minsize $fdisp(topWidget) 100 30
  171.     wm protocol .fl WM_DELETE_WINDOW FdispDeleted
  172.     FdispMakeCanvas $fdisp(topWidget)
  173.     set icon [option get $fdisp(topWidget) iconposition IconPosition]
  174.     catch {
  175.     Exwin_IconPosition $fdisp(topWidget) $icon
  176.     }
  177.     set iconic [option get $fdisp(topWidget) iconic Iconic]
  178.     if {$iconic == {}} {
  179.     set iconic $exmh(iconic)
  180.     }
  181.     if {$iconic} {
  182.     wm iconify $fdisp(topWidget)
  183.     }
  184. }
  185. proc FdispDeleted {} {
  186.     wm iconify .fl
  187.     Exmh_Status "Folder display closed, not destroyed"
  188. }
  189. proc Fdisp_Checkpoint { varName } {
  190.     # Add Xresources lines to $varName that save window size
  191.     upvar $varName newstuff
  192.     global fdisp
  193.     catch {
  194.     set can $fdisp(topWidget).can
  195.     set width [winfo width $can]
  196.     set height [winfo height $can]
  197.     set bd [$can cget -borderwidth]
  198.     incr bd [$can cget -highlightthickness]
  199.     set width [expr $width - 2*$bd]
  200.     set height [expr $height - 2*$bd]
  201.     lappend newstuff "*Fltop.Canvas.height:\t$height"
  202.     lappend newstuff "*Fltop.Canvas.width:\t$width"
  203.     }
  204. }
  205.  
  206. # Create folder list in a frame and make the canvas inside it
  207. proc FdispMakeFrame { } {
  208.     global fdisp
  209.     set fdisp(frame) [Widget_Frame $fdisp(parent) f1 Frame]
  210.     FdispMakeCanvas $fdisp(frame)
  211. }
  212.  
  213. # Create the canvas for the folder display
  214. proc FdispMakeCanvas { frame } {
  215.     global fdisp exwin
  216.     set fdisp(canvas) [canvas $frame.can -bd 2 -relief raised \
  217.     -highlightthickness 0]
  218.     set s [scrollbar $frame.sv -command [list $fdisp(canvas) yview] \
  219.     -highlightthickness 0]
  220.     $fdisp(canvas) configure -yscrollcommand [list $s set]
  221.  
  222.     # Find out how big labels are
  223.     if [catch {
  224.     set id [$fdisp(canvas) create text 0 0 \
  225.         -anchor nw -justify center -text 0123456789 -font $fdisp(font)]
  226.     } err] {
  227.     Exmh_Status $err
  228.     set fdisp(font) fixed
  229.     set id [$fdisp(canvas) create text 0 0 \
  230.         -anchor nw -justify center -text 0123456789 -font $fdisp(font)]
  231.     }
  232.     set size [$fdisp(canvas) bbox $id]
  233.     set fdisp(itemHeight) [expr {[lindex $size 3] - [lindex $size 1]}]
  234.     set fdisp(charWidth) [expr {([lindex $size 2] - [lindex $size 0])/10}]
  235.     $fdisp(canvas) delete $id
  236.  
  237.     catch {
  238.     $fdisp(canvas) configure -yscrollincrement \
  239.         [expr {$fdisp(itemHeight)+$fdisp(ygap)+1}]
  240.     }
  241.  
  242.     if {!$fdisp(toplevel)} {
  243.     set h [expr {$fdisp(maxLines)*($fdisp(itemHeight) + $fdisp(ygap)) + $fdisp(ygap)}]
  244.     $fdisp(canvas) configure -height $h
  245.     }
  246.  
  247.     bindtags $fdisp(canvas) \
  248.     [list $fdisp(canvas) Command [winfo toplevel $fdisp(canvas)] all]
  249.     bind $fdisp(canvas) <2> {%W scan mark %x %y}
  250.     bind $fdisp(canvas) <B2-Motion> {%W scan dragto %x %y}
  251.     bind $fdisp(canvas) <Configure> FdispCanvasConfigure
  252.     pack $s -side $exwin(scrollbarSide) -fill y
  253.     pack $fdisp(canvas) -side $exwin(scrollbarSide) -fill both -expand 1
  254.  
  255.     # fdisp popup color hack
  256.     if {[winfo depth $fdisp(canvas)] <= 4} {
  257.     if {! [regexp {black|white} $fdisp(c_popup)]} {
  258.         set fdisp(c_popup) [$fdisp(canvas) cget -bg]
  259.     }
  260.     }
  261.  
  262.     FdispDragAttach canvas
  263. }
  264. proc FdispFixupFont { args } {
  265.     global exwin fdisp
  266.     if {$fdisp(lastFont) != $fdisp(font)} {
  267.  
  268.     # Find out how big labels are
  269.     if [catch {
  270.         set id [$fdisp(canvas) create text 0 0 \
  271.         -anchor nw -justify center -text foo -font $fdisp(font)]
  272.     } err] {
  273.         Exmh_Status $err
  274.         set fdisp(font) fixed
  275.         set id [$fdisp(canvas) create text 0 0 \
  276.         -anchor nw -justify center -text foo -font $fdisp(font)]
  277.     }
  278.     set size [$fdisp(canvas) bbox $id]
  279.     set fdisp(itemHeight) [expr {[lindex $size 3] - [lindex $size 1]}]
  280.     $fdisp(canvas) delete $id
  281.     set fdisp(lastFont) $fdisp(font)
  282.  
  283.     # Changing canvas size triggers redisplay
  284.     set h [expr {$fdisp(maxLines)*($fdisp(itemHeight) + $fdisp(ygap)) + $fdisp(ygap)}]
  285.     $fdisp(canvas) configure -height $h
  286.     if [info exists fdisp(cache)] {
  287.         set h [expr {($fdisp(itemHeight) + $fdisp(ygap)) + $fdisp(ygap)}]
  288.         $fdisp(cache) configure -height $h
  289.     }
  290.     }
  291. }
  292.  
  293. proc Fdisp_Window { parent } {
  294.     global fdisp exwin
  295.  
  296.     set fdisp(parent) $parent
  297.  
  298.     # a bogus child is needed inside fdisp(parent) so it properly
  299.     # shrinks down when the cache is removed or when the main display
  300.     # is moved to a separate top-level
  301.     Widget_Frame $parent bogus Frame
  302.  
  303.     # The following creates fdisp(canvas), either in a toplevel or a frame
  304.     FdispMake
  305.  
  306.     global fcache
  307.     if $fcache(enabled) {
  308.     Fcache_CreateWindow
  309.     FdispDragAttach cache
  310.     }
  311.  
  312.     set fdisp(folder) .
  313.     foreach can {canvas cache} {
  314.     set fdisp(entered,$can) 0        ;# Display routine entered
  315.     set fdisp(pending,$can) 0        ;# Display routine blocked
  316.     set fdisp(width,$can) 0            ;# last display width
  317.     set fdisp(fset,$can) {}            ;# last folder set
  318.     set fdisp(cur,$can) {}            ;# current folder name
  319.     set fdisp(tar,$can) {}            ;# target folder name
  320.     set fdisp(curid,$can) {}        ;# canvas item ids
  321.     set fdisp(boxid,$can) {}
  322.     set fdisp(tarid,$can) {}
  323.     set fdisp(tboxid,$can) {}
  324.     set fdisp(leafs,$can) {}        ;# list of leaf highlight tags
  325.     }
  326.  
  327. }
  328. proc Fdisp_Redisplay {} {
  329.     global fdisp
  330.     FdispMain $fdisp(folder) 1
  331.     Fcache_Display 1
  332. }
  333.  
  334. proc FdispCanvasConfigure {} {
  335.     global fdisp
  336.     FdispMain $fdisp(folder) 1
  337. }
  338.  
  339. proc FdispMain { {folder {.}} {force 0} } {
  340.     # Layout the current level of folder buttons on the canvas
  341.     global fdisp exmh
  342.     Label_Main [expr {[string compare $folder "."]==0 ? {} : "$folder"}]
  343.     set fdisp(folder) $folder
  344.     Flist_FindAllFolders
  345.     set folderSet [Flist_FolderSet $folder]
  346.     set len [llength $folderSet]
  347.     set msec [lindex [time [list Fdisp_Layout canvas $folderSet $folder $force]] 0]
  348.     Exmh_Debug Fdisp_HighlightCanvas [time [list Fdisp_HighlightCanvas canvas]]
  349. }
  350.  
  351. proc Fdisp_Layout { can folderSet {folder {}} {force 0} } {
  352.     # Main layout routine.  Because this is triggered by
  353.     # <Configure> events, and because it dinks with the
  354.     # size of the canvas, it needs to be reentrant.
  355.     #
  356.     global fdisp
  357.  
  358.     set canvas $fdisp($can)
  359.  
  360.     if {$fdisp(entered,$can)} {
  361.     set fdisp(pending,$can) 1
  362.     return
  363.     }
  364.     set width [winfo width $canvas]
  365.     set bd [$canvas cget -borderwidth]
  366.     incr bd [$canvas cget -highlightthickness]
  367.     set width [expr $width - 2*$bd]
  368.  
  369.     if {! $force &&
  370.     ($width == $fdisp(width,$can)) &&
  371.     ($folderSet == $fdisp(fset,$can))} {
  372.     if {$fdisp(pending,$can)} {
  373.         set fdisp(pending,$can) 0
  374.         after 1 [list Fdisp_Layout $can $folderSet $folder]
  375.     }
  376.     return
  377.     }
  378.     incr fdisp(entered,$can)
  379.  
  380.     set fdisp(width,$can) $width
  381.     set fdisp(fset,$can) $folderSet
  382.  
  383.     catch { $canvas delete all }
  384.     Fdisp_ClearSpecials $canvas
  385.  
  386.     if {$can != "cache"} {
  387.     FdispPopdownReset
  388.     Exmh_Status "Building folder display... $folder"
  389.     }
  390.     set fdisp(maxy,$can) [FdispLayoutInner $can $fdisp(xgap) $fdisp(ygap) \
  391.             $width $folderSet $folder FdispBindLabel]
  392.  
  393.     set fdisp(bgid,$can) [$canvas create rect 0 0 0 0 \
  394.         -fill [$canvas cget -bg] -outline ""]
  395.     $canvas lower $fdisp(bgid,$can)
  396.     FdispSetCanvasSize $can $fdisp(maxy,$can)
  397.     if {$can != "cache"} {
  398.     Exmh_Status ""
  399.     }
  400.     incr fdisp(entered,$can) -1
  401.     if {$fdisp(pending,$can)} {
  402.     set fdisp(pending,$can) 0
  403.     after 1 [list Fdisp_Layout $can $folderSet $folder]
  404.     }
  405. }
  406. proc FdispLayoutInner { can x1 y1 width folderSet folder bindProc {skipSelf no} {tag _notag_} } {
  407.     global fdisp
  408.     set canvas $fdisp($can)
  409.     set maxy $fdisp(itemHeight)        ;# Per row max item height
  410.     set x $x1
  411.     set y $y1
  412.     set iscache [string match cache $can]
  413.     foreach f $folderSet {
  414.     # Determine label text for the folder
  415.     if {[string compare $f $folder] == 0} {
  416.         if [string match skipSelf $skipSelf] {
  417.         continue
  418.         } else {
  419.         set text ".."
  420.         }
  421.     } else {
  422.         if $iscache {
  423.         set text [Fcache_FolderName $f]
  424.         } else {
  425.         set text [file tail $f]
  426.         }
  427.     }
  428.     # Create the text (or bitmap) at location 0 0
  429.     set id [Fdisp_Label $canvas $f $text]
  430.     set bbox [$canvas bbox $id]
  431.     set twidth [expr [lindex $bbox 2]-[lindex $bbox 0]]
  432.     set theight [expr [lindex $bbox 3]-[lindex $bbox 1]]
  433.     if {($twidth + $fdisp(xgap)/2 + $x > $width) ||
  434.         (($fdisp(oneCol) && !$iscache) && ($y > $y1 || $x > $x1))} {
  435.         incr y [expr {$fdisp(ygap) + $maxy}]
  436.         set x $x1
  437.         set maxy $fdisp(itemHeight)        ;# Per row max item height
  438.     }
  439.     if {$theight > $maxy} {
  440.         set maxy $theight
  441.     }
  442.     # Move it into position after we see how big it is.
  443.     $canvas move $id $x $y
  444.     incr x [expr {$fdisp(xgap) + $twidth}]
  445.  
  446.     # Determine style of the box, depending on nesting
  447.     if {[string compare $f $folder] == 0} {
  448.         set ftype goParent
  449.     } else {
  450.         if [Flist_SubFolders $f] {
  451.         if $iscache {
  452.             # This supresses the drop-shadow in the cache display,
  453.             # but also turns off the redisplay mode behavior...
  454.             set ftype leaf
  455.         } else {
  456.             set ftype hasNested
  457.         }
  458.         } else {
  459.         set ftype leaf
  460.         }
  461.     }
  462.     set box [Fdisp_Box $fdisp($can) $id $ftype $tag]
  463.     FdispUpdateMap $can $f $id
  464.     FdispUpdateBmap $can $f $box
  465.     $bindProc $can $id $ftype $f
  466.     if {$fdisp(popdownAction) != "enter"} {
  467.         $bindProc $can $box $ftype $f
  468.     }
  469.     }
  470.     return [expr $y + $maxy]
  471. }
  472. proc Fdisp_Label { canvas f text } {
  473.     global fdisp folderInfo fdispSpecial
  474.     if [info exists folderInfo(bitmap,$f)] {
  475.     set special 0
  476.     if [info exists folderInfo(fg,$f)] {
  477.         set fg $folderInfo(fg,$f)
  478.         set special 1
  479.     } else {
  480.         set fg black
  481.     }
  482.     if [info exists folderInfo(bg,$f)] {
  483.         set bg $folderInfo(bg,$f)
  484.         set special 1
  485.     } else {
  486.         set bg white
  487.     }
  488.     set id [$canvas create bitmap 0 0 -anchor nw \
  489.             -bitmap $folderInfo(bitmap,$f) \
  490.             -foreground $fg -background $bg]
  491.     if {! $special} {
  492.         $canvas addtag bitmap withtag $id
  493.     } else {
  494.         lappend fdispSpecial($canvas) $id
  495.         set fdispSpecial($canvas,$id) [list $fg $bg]
  496.     }
  497.     } else {
  498.     set id [$canvas create text 0 0 -anchor nw \
  499.         -justify center -text $text -font $fdisp(font) -tag text]
  500.     }
  501.     return $id
  502. }
  503. proc Fdisp_FixupSpecials { canvas } {
  504.     global fdispSpecial
  505.     if ![info exists fdispSpecial($canvas)] {
  506.     return
  507.     }
  508.     foreach id $fdispSpecial($canvas) {
  509.     if [info exists fdispSpecial($canvas,$id)] {
  510.         set fg [lindex $fdispSpecial($canvas,$id) 0]
  511.         set bg [lindex $fdispSpecial($canvas,$id) 1]
  512.         $canvas itemconfigure $id -background $bg -foreground $fg
  513.     }
  514.     }
  515. }
  516. proc Fdisp_ClearSpecials { canvas } {
  517.     global fdispSpecial
  518.     if ![info exists fdispSpecial($canvas)] {
  519.     return
  520.     }
  521.     foreach id $fdispSpecial($canvas) {
  522.     unset fdispSpecial($canvas,$id)
  523.     }
  524.     unset fdispSpecial($canvas)
  525. }
  526. proc Fdisp_Box { canvas tid ftype {tag {}} } {
  527.     # outline box.  I note that for variable width fonts,
  528.     # the bbox is too long.  Oh well.
  529.     global fdisp
  530.  
  531.     if {$tag != {}} {
  532.     $canvas addtag $tag withtag $tid
  533.     }
  534.  
  535.     set bbox [$canvas bbox $tid]
  536.     set x1 [expr {[lindex $bbox 0] - 1}]
  537.     set x2 [expr {[lindex $bbox 2] + 1}]
  538.     set y1 [expr {[lindex $bbox 1] - 1}]
  539.     set y2 [expr {[lindex $bbox 3] + 1}]
  540.  
  541.     set box [$canvas create rect $x1 $y1 $x2 $y2 -fill $fdisp(c_bg) \
  542.     -tags [list box $tag]]
  543.  
  544.     # Need one box for a dropshadow, and then one extra box to ensure
  545.     # a stippled foreground obscures the dropshadow box
  546.     if {[string compare $ftype goParent] == 0} {
  547.     $canvas lower [$canvas create rect $x1 $y1 $x2 $y2 \
  548.                 -fill $fdisp(c_bg) -tags $tag]
  549.     $canvas lower [$canvas create rect \
  550.         [expr $x1+3] [expr $y1+3] [expr $x2+3] [expr $y2+3] \
  551.                 -fill $fdisp(c_bg) -tags $tag]
  552.     } else {
  553.     if {[string compare $ftype hasNested] == 0} {
  554.         $canvas lower [$canvas create rect $x1 $y1 $x2 $y2 \
  555.                 -fill $fdisp(c_bg) -tags $tag]
  556.         $canvas lower [$canvas create rect \
  557.         [expr $x1+3] [expr $y1+3] [expr $x2+3] [expr $y2+3] \
  558.                 -fill $fdisp(c_fg) -tags $tag]
  559.     }
  560.     }
  561.     $canvas raise $tid    ;# display text over top the box
  562.     return $box
  563. }
  564. proc FdispBindLabel { can id ftype f } { 
  565.     global fdisp
  566.     set canvas $fdisp($can)
  567.  
  568.     $canvas bind $id <$fdisp(curbutton)> [list Folder_Change $f]
  569.     if {$fdisp(tarbuttonAction) == "select+move"} {
  570.         $canvas bind $id <$fdisp(tarbutton)> \
  571.                 [list Folder_TargetMove $f]
  572.     } elseif {$fdisp(tarbuttonAction) == "select+copy"} {
  573.         $canvas bind $id <$fdisp(tarbutton)> \
  574.                 [list Folder_TargetCopy $f]
  575.     } elseif {$fdisp(tarbuttonAction) == "select only"} {
  576.         $canvas bind $id <$fdisp(tarbutton)> \
  577.                 [list Folder_Target $f]
  578.     } else {
  579.         $canvas bind $id <$fdisp(tarbutton)> \
  580.                 [list Folder_TargetMove $f]
  581.     }
  582.     $canvas bind $id <Shift-$fdisp(tarbutton)> \
  583.             [list Folder_TargetCopy $f]
  584.     $canvas bind $id <Control-$fdisp(tarbutton)> \
  585.             [list Folder_TargetClear]
  586.  
  587.  
  588.     if {[string compare $ftype goParent] == 0} {
  589.     $canvas bind $id <$fdisp(navbutton)> \
  590.         [list FdispMain [file dirname $f]]
  591.     } else {
  592.     if {[string compare $ftype hasNested] == 0} {
  593.         if {$can != "cache"} {
  594.         case $fdisp(popdownAction) {
  595.             redisplay {
  596.             $canvas bind $id <$fdisp(navbutton)> \
  597.                 [list FdispMain $f]
  598.             }
  599.             enter {
  600.             $canvas bind $id <Any-Enter> \
  601.                 [list FdispDisplayPopdown $f down %x %y]
  602.             }
  603.             navbutton {
  604.             $canvas bind $id <$fdisp(navbutton)> \
  605.                 [list FdispDisplayPopdown $f down %x %y]
  606.             }
  607.         }
  608.         } else {
  609.         if {$fdisp(popdownAction) == "redisplay"} {
  610.             $canvas bind $id <$fdisp(navbutton)> \
  611.                 [list FdispMain $f]
  612.         }
  613.         }
  614.     } else {
  615.         # Leaf
  616.         if {$fdisp(popdownAction) == "redisplay"} {
  617.         $canvas bind $id <$fdisp(navbutton)> {}
  618.         } else {
  619.         if {$fdisp(popdownRemove) == "navbutton"} {
  620.             $canvas bind $id <$fdisp(navbutton)> FdispPopdownRemove
  621.         } else {
  622.             # Use enter on another leaf label to simulate Leave
  623.             # of the popdown.  Cannot bind to <Leave> on the popdown
  624.             # background because that triggers when you enter one
  625.             # of its own labels.
  626.             $canvas bind $id <Enter> FdispPopdownRemove
  627.         }
  628.         }
  629.     }
  630.     }
  631. }
  632. proc FdispSetCanvasSize { can maxy {noshrink 0}} {
  633.     global fdisp
  634.  
  635.     set canvas $fdisp($can)
  636.     set w $fdisp(width,$can)
  637.  
  638.     set height [winfo height $canvas]
  639.     set bd [$canvas cget -borderwidth]
  640.     incr bd [$canvas cget -highlightthickness]
  641.     set height [expr $height - 2*$bd]
  642.  
  643.     set h [expr $maxy + $fdisp(ygap) + $fdisp(ygap)]
  644.     if {$height > $h} {set h $height}
  645.  
  646.     #puts "SetSize $maxy->$h [lindex [$canvas cget -scrollregion] 3]"
  647.  
  648.     if {$noshrink && [lindex [$canvas cget -scrollregion] 3] > $h} {
  649.     return
  650.     }
  651.  
  652.     $canvas configure -scrollregion [list 0 0 $w $h]
  653.     # adjust background to cover new scrollregion
  654.     $canvas coords $fdisp(bgid,$can) 0 0 $w $h
  655. }
  656.  
  657. proc FdispUpdateMap { can folder id } {
  658.     global fdisp
  659.     $fdisp($can) addtag Ftext=$folder withtag $id
  660. }
  661. proc FdispUpdateBmap { can folder box } {
  662.     global fdisp
  663.     $fdisp($can) addtag Fbox=$folder withtag $box
  664. }
  665. proc FdispGetMap { can folder } {
  666.     global fdisp
  667.     return [$fdisp($can) find withtag Ftext=$folder]
  668. }
  669. proc FdispGetBmap { can folder } {
  670.     global fdisp
  671.     return [$fdisp($can) find withtag Fbox=$folder]
  672. }
  673. # Routines to Highlight the folder display
  674.  
  675. proc Fdisp_ResetHighlights {} {
  676.     global fdisp
  677.     Fdisp_ClearHighlights
  678.     Fdisp_HighlightCanvas canvas
  679.     if [info exists fdisp(cache)] {
  680.     Fdisp_HighlightCanvas cache
  681.     }
  682. }
  683. proc Fdisp_ClearHighlights {} {
  684.     global fdisp
  685.     FdispClearHighlights canvas
  686.     if [info exists fdisp(cache)] {
  687.     FdispClearHighlights cache
  688.     }
  689. }
  690.  
  691. proc Fdisp_HighlightCanvas { can } {
  692.     global fdisp flist
  693.     if ![info exist fdisp($can)] {
  694.     return
  695.     }
  696.     if {$fdisp(cur,$can) != {}} {
  697.     FdispHighlightCur $can $fdisp(cur,$can)
  698.     }
  699.     if {$fdisp(tar,$can) != {}} {
  700.     FdispHighlightTarget $can $fdisp(tar,$can)
  701.     }
  702.     foreach f [Flist_UnseenFolders] {
  703.     FdispHighlightUnseen $can $f
  704.     }
  705.     Fdisp_LabelConfigure $fdisp($can)
  706. }
  707.  
  708. proc FdispWhichLabel { can f } {
  709.     # Figure out what label to highlight, handling nesting
  710.     global fdisp mhProfile
  711.  
  712.     if {"$can" == "cache" || [FdispNotDotDot $can $f]} {
  713.     return $f
  714.     }
  715.     while {[string compare $f "."] && [string compare $f "/"]} {
  716.     set nf [file dirname $f]
  717.     if {[string compare $nf $f] == 0} {
  718.         break
  719.     }
  720.     set f $nf
  721.     if [FdispNotDotDot $can $f] {
  722.         return $f
  723.     }
  724.     }
  725.     return {}
  726. }
  727. proc FdispAllLabels { can f } {
  728.     # Figure out what labels to highlight, returning
  729.     # multiple labels if they are present because of popdowns.
  730.     global fdisp mhProfile
  731.  
  732.     set res {}
  733.     if [FdispNotDotDot $can $f] {
  734.     lappend res $f
  735.     }
  736.     while {[string compare $f "."] && [string compare $f "/"]} {
  737.     set nf [file dirname $f]
  738.     if {[string compare $nf $f] == 0} {
  739.         break
  740.     }
  741.     set f $nf
  742.     if [FdispNotDotDot $can $f] {
  743.         lappend res $f
  744.     }
  745.     }
  746.     return $res
  747. }
  748. # See if the folder label displayed for $f is ".." (and is displayed at all)
  749. proc FdispNotDotDot { can f } {
  750.     global fdisp
  751.     set map [FdispGetMap $can $f]
  752.     if {$map != {}} {
  753.     if [catch {$fdisp($can) itemcget $map -text} l] {
  754.         if [string compare $f ".."] {
  755.         return 1
  756.         }
  757.     } else {
  758.         if [string compare $l ".."] {
  759.         return 1
  760.         }
  761.     }
  762.     }
  763.     return 0
  764. }
  765. proc Fdisp_HighlightCur { f } {
  766.     global fdisp
  767.  
  768.     Fcache_Folder $f
  769.     foreach can {canvas cache} {
  770.     if [info exists fdisp($can)] {
  771.         FdispHighlightCur $can $f
  772.         Fdisp_LabelConfigure $fdisp($can)
  773.     }
  774.     }
  775. }
  776. proc FdispHighlightCur { can f } {
  777.     global fdisp
  778.     set l [FdispWhichLabel $can $f]
  779.     set canvas $fdisp($can)
  780.     if {$fdisp(curid,$can) != {}} {
  781.     $canvas dtag $fdisp(curid,$can) cur[$canvas type $fdisp(curid,$can)]
  782.     $canvas dtag $fdisp(boxid,$can) curbox
  783.     }
  784.  
  785.     set fdisp(cur,$can) $f
  786.     if {[string compare $l {}]} {
  787.     set id [FdispGetMap $can $l]
  788.     set box [FdispGetBmap $can $l]
  789.     $canvas addtag cur[$canvas type $id] withtag $id
  790.     $canvas addtag curbox withtag $box
  791.     set fdisp(curid,$can) $id
  792.     set fdisp(boxid,$can) $box
  793.     }
  794. }
  795. proc Fdisp_HighlightTarget { f } {
  796.     global fdisp fcache
  797.  
  798.     if $fcache(cacheTarget) {
  799.        Fcache_Folder $f
  800.     }
  801.     foreach can {canvas cache} {
  802.     if [info exists fdisp($can)] {
  803.         FdispHighlightTarget $can $f
  804.         Fdisp_LabelConfigure $fdisp($can)
  805.     }
  806.     }
  807. }
  808. proc FdispHighlightTarget { can f } {
  809.     global fdisp
  810.     set l [FdispWhichLabel $can $f]
  811.     set canvas $fdisp($can)
  812.     if {$fdisp(tarid,$can) != {}} {
  813.     $canvas dtag $fdisp(tarid,$can) tar[$canvas type $fdisp(tarid,$can)]
  814.     $canvas dtag $fdisp(tboxid,$can) tarbox
  815.     }
  816.  
  817.     set fdisp(tar,$can) $f
  818.     if {[string compare $l {}]} {
  819.     set id [FdispGetMap $can $l]
  820.     set box [FdispGetBmap $can $l]
  821.     $canvas addtag tar[$canvas type $id] withtag $id
  822.     $canvas addtag tarbox withtag $box
  823.     set fdisp(tarid,$can) $id
  824.     set fdisp(tboxid,$can) $box
  825.     }
  826. }
  827.  
  828. proc Fdisp_HighlightUnseen { f } {
  829.     global fdisp fcache
  830.  
  831.     if $fcache(cacheUnseen) {
  832.        Fcache_Folder $f
  833.     }
  834.     foreach can {canvas cache} {
  835.     if [info exists fdisp($can)] {
  836.         FdispHighlightUnseen $can $f
  837.         Fdisp_LabelConfigure $fdisp($can)
  838.     }
  839.     }
  840. }
  841. proc FdispHighlightUnseen { can f } {
  842.     global exmh fdisp
  843.     if {$can != "cache"} {
  844.     set ll [FdispAllLabels $can $f]
  845.     } else {
  846.     set ll [list $f]
  847.     }
  848.     set canvas $fdisp($can)
  849.     foreach l $ll {
  850.     set id [FdispGetMap $can $l]
  851.     set box [FdispGetBmap $can $l]
  852.     $canvas addtag leaf=$f withtag $id
  853.     if {[lsearch $fdisp(leafs,$can) leaf=$f] < 0} {
  854.         # needed when resetting highlights
  855.         lappend fdisp(leafs,$can) leaf=$f
  856.     }
  857.     $canvas addtag unsn[$canvas type $id] withtag $id
  858.     $canvas addtag unsnbox withtag $box
  859.     }
  860. }
  861. proc Fdisp_UnHighlightUnseen { f } {
  862.     global fdisp
  863.     foreach can {canvas cache} {
  864.     if [info exists fdisp($can)] {
  865.         FdispUnHighlightUnseen $fdisp($can) $can $f
  866.         Fdisp_LabelConfigure $fdisp($can)
  867.     }
  868.     }
  869. }
  870. proc FdispUnHighlightUnseen { canvas can f } {
  871.     global exmh fdisp
  872.     set ll [FdispAllLabels $can $f]
  873.     set canvas $fdisp($can)
  874.     foreach l $ll {
  875.     set id [FdispGetMap $can $l]
  876.     set box [FdispGetBmap $can $l]
  877.     set stillLight 0
  878.     foreach tag [$canvas gettags $id] {
  879.         if [string match leaf=* $tag] {
  880.         set leaf [lindex [split $tag =] 1]
  881.         if {[string compare $leaf $f] == 0} {
  882.             $canvas dtag $id $tag
  883.         } else {
  884.             set stillLight 1
  885.         }
  886.         }
  887.     }
  888.     if {! $stillLight} {
  889.         $canvas dtag $id unsn[$canvas type $id]
  890.         $canvas dtag $box unsnbox
  891.     }
  892.     }
  893. }
  894. proc Fdisp_Lines { canvas labels } {
  895.     # Return the number of lines needed to display the set of labels
  896.     global fdisp
  897.     set x $fdisp(xgap)
  898.     set lines 1
  899.     set width [winfo width $canvas]
  900.     set bd [$canvas cget -borderwidth]
  901.     incr bd [$canvas cget -highlightthickness]
  902.     set width [expr $width - 2*$bd]
  903.     foreach folder $labels {
  904.     set f [Fcache_FolderName $folder]
  905.     set id [Fdisp_Label $canvas $f $f]
  906.     set bbox [$canvas bbox $id]
  907.     set twidth [expr [lindex $bbox 2]-[lindex $bbox 0]]
  908.     if {$twidth + $fdisp(xgap)/2 + $x > $width} {
  909.         incr lines
  910.         set x $fdisp(xgap)
  911.     }
  912.     incr x [expr {$fdisp(xgap) + $twidth}]
  913.     $canvas delete $id
  914.     }
  915.     return $lines
  916. }
  917.  
  918. #
  919. # Interface to Drag & Drop
  920. #
  921. set fdispDrag(callback) FdispDragRelease
  922. set fdispDrag(types) {folder filename}
  923. set fdispDrag(formats) string
  924. set fdispDrag(format,folder) string
  925. set fdispDrag(format,filename) string
  926. set fdispDrag(type,string) folder
  927. set fdispDrag(decorate) FdispDragWindow
  928.  
  929. proc FdispDragAttach {where} {
  930.     global fdisp
  931.  
  932.     Drag_Attach $fdisp($where) FdispDragSelect Shift $fdisp(navbutton)
  933.     if [string match cache $where] {
  934.         Drop_Attach $fdisp(cache) FdispDropCache
  935.     } else {
  936.         Drop_Attach $fdisp(canvas) FdispDropCanvas
  937.     }
  938. }
  939.  
  940. # A drag was dropped on the cache
  941. proc FdispDropCache {w args} {
  942.     global dragging
  943.  
  944.     if ![info exists dragging(data,folder)] return
  945.     set folder $dragging(data,folder)
  946.  
  947.     # Add the folder to the cache
  948.     Fcache_Folder $folder
  949. }
  950.  
  951. # A drag was dropped on the canvas
  952. proc FdispDropCanvas {w args} {
  953.     global fdisp dragging
  954.  
  955.     if ![info exists dragging(data,folder)] return
  956.     set folder $dragging(data,folder)
  957.  
  958.     # If dropped on the folder display and source was cache,
  959.     # remove the folder from the cache
  960.     if {[info exists fdisp(cache)] && 
  961.         $dragging(source) == $fdisp(cache)} {
  962.         Fcache_FolderDiscard $folder
  963.     }
  964. }
  965.  
  966. # Called when after a drag we sourced has been dropped
  967. proc FdispDragRelease {dstw args} {
  968.  
  969.     global fdisp dragging
  970.     set folder $dragging(data,folder)
  971.  
  972. tlog-add .t "released on $dstw"
  973.  
  974.     # If we tossed it somewhere unknown, Add the folder to the cache
  975.     if {$dragging(source) == $fdisp(canvas) && $dstw != $fdisp(canvas) &&
  976.         "$dstw" != {}} {
  977.         Fcache_Folder $folder
  978.     }
  979. }
  980.  
  981. # Drag Selected
  982. proc FdispDragSelect {c x y wx wy} {
  983.     global fdisp
  984.  
  985.     set closest [$c find closest [$c canvasy $wx] [$c canvasy $wy]]
  986.  
  987.     # Find what folder we're over
  988.     set tags [$c gettags $closest]
  989.     set which [lsearch -glob $tags F*=*]
  990.     if {$which >= 0} {
  991.         set tag [lindex $tags $which]
  992.         regsub -- .*=(.*) $tag {\1} folder
  993.     }
  994.     if ![info exists folder] return
  995.  
  996.     # Hand off to Drag code
  997.     global fdispDrag mhProfile
  998.     set fdispDrag(source) $c
  999.     set fdispDrag(data,folder) $folder
  1000.     set fdispDrag(data,filename) $mhProfile(path)/$folder
  1001.  
  1002.     Drag_Source fdispDrag $x $y
  1003.  
  1004. }
  1005.  
  1006. # How do decorate the Drag window
  1007. proc FdispDragWindow {w} {
  1008.     global fdisp dragging
  1009.  
  1010.     set c $w.fdisp
  1011.     if ![winfo exists $c] {
  1012.         set height [expr $fdisp(itemHeight) + $fdisp(ygap)]
  1013.         canvas $c -height $height
  1014.     }
  1015.  
  1016.     pack $c
  1017.     catch {$c delete all}
  1018.  
  1019.     set f $dragging(data,folder)
  1020.  
  1021.     set id [Fdisp_Label $c $f $f]
  1022.     set bbox [$c bbox $id]
  1023.     set twidth [expr [lindex $bbox 2]-[lindex $bbox 0]]
  1024.     set theight [expr [lindex $bbox 3]-[lindex $bbox 1]]
  1025.     $c move $id [expr $fdisp(xgap)/2 + 1] [expr $fdisp(ygap)/2]
  1026.     set width [expr $twidth + $fdisp(xgap)]
  1027.     $c config -width $width
  1028.     set bid [Fdisp_Box $c $id leaf {}]
  1029. }
  1030.